This analysis was performed as a demonstration for the California Air Resources Board. The purpose is to use a historical record of potential wildfire smoke exposures to identify affected parts of the state with concentrations of school aged children living in poverty.
Smoke exposures are approximated using the Hazard Mapping System (HMS) Smoke Product, produced and distributed by the National Oceanic and Atmospheric Administration (NOAA).
It obtains census tract level estimates for students enrolled and living below the poverty line for example, for grades 1 through 4
Here is a map to view the data by grade level. Colors are assigned by quantile (top 20%, bottom 20%) of all tracts. The data is the number of student-days from 2010-2019.
data <- left_join(tracts_sp, smoke_exp)
pal <-
colorQuantile(
palette = c("#fee5d9", "#fcae91", "#fb6a4a", "#de2d26", "#a50f15"),
n = 5,
domain = 0:max(data$enrolled_in_poverty, na.rm = T)
)
pal2 <-
colorQuantile(
palette = c("#fee5d9", "#fcae91", "#fb6a4a", "#de2d26", "#a50f15"),
n = 5,
domain = 0:max(data$nursery, na.rm = T)
)
pal3 <-
colorQuantile(
palette = c("#fee5d9", "#fcae91", "#fb6a4a", "#de2d26", "#a50f15"),
n = 5,
domain = 0:max(data$kindergarten, na.rm = T)
)
pal4 <-
colorQuantile(
palette = c("#fee5d9", "#fcae91", "#fb6a4a", "#de2d26", "#a50f15"),
n = 5,
domain = 0:max(data$grade1_4, na.rm = T)
)
pal5 <-
colorQuantile(
palette = c("#fee5d9", "#fcae91", "#fb6a4a", "#de2d26", "#a50f15"),
n = 5,
domain = 0:max(data$grade5_8, na.rm = T)
)
pal6 <-
colorQuantile(
palette = c("#fee5d9", "#fcae91", "#fb6a4a", "#de2d26", "#a50f15"),
n = 5,
domain = 0:max(data$grade9_12, na.rm = T)
)
# here we create the Leaft map with two layers, one for all ages and one for elderly
leaflet() %>%
# addProviderTiles(providers$Esri.WorldStreetMap, group = "Street Map") %>%
# addProviderTiles(providers$Stamen.Terrain, group = "Terrain") %>%
# addProviderTiles(providers$Esri.WorldImagery, group = "Sattelite") %>%
addProviderTiles(providers$Stamen.Toner, group = "B/W") %>%
addPolygons(
data = data,
color = "#444444",
weight = 1,
smoothFactor = 0.1,
fillOpacity = 0.8,
fillColor = ~ pal(data$enrolled_in_poverty),
stroke = FALSE,
label = ~ data$enrolled_in_poverty,
group = "Enrolled in school and in Poverty"
) %>%
addPolygons(
data = data,
color = "#444444",
weight = 1,
smoothFactor = 0.1,
fillOpacity = 0.8,
fillColor = ~ pal2(data$nursery),
stroke = FALSE,
label = ~ data$nursery,
group = "Nursery School and in Poverty"
) %>%
addPolygons(
data = data,
color = "#444444",
weight = 1,
smoothFactor = 0.1,
fillOpacity = 0.8,
fillColor = ~ pal3(data$kindergarten),
stroke = FALSE,
label = ~ data$kindergarten,
group = "Kindergarten and in Poverty"
) %>%
addPolygons(
data = data,
color = "#444444",
weight = 1,
smoothFactor = 0.1,
fillOpacity = 0.8,
fillColor = ~ pal4(data$grade1_4),
stroke = FALSE,
label = ~ data$grade1_4,
group = "Elementary School and in Poverty"
) %>%
addPolygons(
data = data,
color = "#444444",
weight = 1,
smoothFactor = 0.1,
fillOpacity = 0.8,
fillColor = ~ pal5(data$grade5_8),
stroke = FALSE,
label = ~ data$grade5_8,
group = "Middle School and in Poverty"
) %>%
addPolygons(
data = data,
color = "#444444",
weight = 1,
smoothFactor = 0.1,
fillOpacity = 0.8,
fillColor = ~ pal6(data$grade9_12),
stroke = FALSE,
label = ~ data$grade9_12,
group = "High School and in Poverty"
) %>%
addLayersControl(
# baseGroups = c("Street Map", "Terrain", "Sattelite", "B/W"),
baseGroups = c(
"Enrolled in school and in Poverty",
"Nursery School and in Poverty",
"Kindergarten and in Poverty",
"Elementary School and in Poverty",
"Middle School and in Poverty",
"High School and in Poverty"
),
options = layersControlOptions(collapsed = FALSE)
) %>%
setView(lat = 37.085206,
lng = -119.540085,
zoom = 6) %>% #defaults the view of the original map to show the entire state
addEasyButton(easyButton(
icon = "fa-globe",
title = "Zoom to State",
onClick = JS(
"function(btn, map){ map.setView([37.085206, -119.540085],6); }"
)
)) %>% # adds a button to return to the whole state view
addLegend(
"bottomleft",
pal = pal2,
values = na.omit(data$enrolled_in_poverty),
labels = c("top 20%", "", "", "", "top 20%"),
opacity = 1,
title = "Student Days Heavy Smoke Exposure 2010-2019"
) %>%
##lables = c("X%-X% (most vulnerable)","X%-X%","X%-X%","X%-X%","X%-X% (least"%. In this tract, the "mapTemp$def," is higher than "mapTemp),))##
leaflet::hideGroup(
c(
"Nursery School and in Poverty",
"Kindergarten and in Poverty",
"Elementary School and in Poverty",
"Middle School and in Poverty",
"High School and in Poverty"
)
)